Pascal Super Library/Pascal Super Library (CW International)(1997).bin/MATH/VECTOR/MATH1.PAS

Pascal/Delphi Source File | 1994-07-07 | 5.2 KB | 279 lines

Unit Math1;

interface

uses winprocs;

FUNCTION ARCCOS(C:REAL):REAL;
FUNCTION LOG(Y,DEFAULT:REAL):REAL;
FUNCTION LOGBASE(Y,BASE,DEFAULT:REAL):REAL;
FUNCTION LIGHT(A1,A2,A3,B1,B2,B3,C1,C2,C3,L1,L2,L3:REAL;AC:INTEGER):REAL;
PROCEDURE VUNIT(I,J,K,o1,o2,o3:REAL;MODE:BOOLEAN;VAR VU);
PROCEDURE CROSSPRODUCT(V1,V2,V3,V4,V5,V6,V7,V8,V9:REAL;VAR CA);
FUNCTION  DOTPRODUCT(V1,V2,V3,V4,V5,V6,V7,V8,V9:REAL;MODE:BOOLEAN):real;
PROCEDURE SORT5000(N:INTEGER;VAR OL,NL);

implementation

FUNCTION ARCCOS(C:REAL):REAL;

VAR
S,F:REAL;
BEGIN
{c must be a number -1=<number<= 1, function gives arccos of c}
IF ABS(C)>1 THEN
BEGIN
ARCCOS:=0;
END
ELSE
BEGIN
IF C=0 THEN
BEGIN
ARCCOS:=PI/2;
END
ELSE
BEGIN
IF C=1 THEN
BEGIN
S:=0;
F:=ARCTAN(S/C);
END
ELSE
BEGIN
S:=SQRT(1-SQR(C));
F:=ARCTAN(S/ABS(C));
END;
IF C<0 THEN
BEGIN
ARCCOS:=F*(C/(ABS(C)))+PI;
END
ELSE
BEGIN
ARCCOS:=F;
END;
END;
END;
END;


FUNCTION LOG(Y,DEFAULT:REAL):REAL;
BEGIN
{finds log (base 10) of y}
IF Y<=0 THEN
BEGIN
LOG:=DEFAULT;
END
ELSE
BEGIN
LOG:=(LN(Y))/(LN(10));
END;
END;

FUNCTION LOGBASE(Y,BASE,DEFAULT:REAL):REAL;
BEGIN
{finds the log (of base specified by base) of y}
IF Y<=0 THEN
BEGIN
LOGBASE:=DEFAULT;
END
ELSE
BEGIN
IF BASE<=0 THEN
BEGIN
LOGBASE:=DEFAULT;
END
ELSE
BEGIN
IF LN(BASE)=0 THEN
BEGIN
LOGBASE:=DEFAULT;
END
ELSE
BEGIN
LOGBASE:=(LN(Y))/(LN(BASE));
END;
END;
END;
END;


FUNCTION LIGHT(A1,A2,A3,B1,B2,B3,C1,C2,C3,L1,L2,L3:REAL;AC:INTEGER):REAL;
VAR
CP:ARRAY[1..3] OF REAL;
DP:ARRAY[1..3] OF REAL;
VUP:ARRAY[1..3] OF REAL;
a:real;
BEGIN
{finds the angle between light directed at the normal at c1c2c3 and l1l2l3.  a1a2a3-c1c2c3 is
crossproducted with b1b2b3-c1c2c3(note: both vectors lie in surface of object) then l1l2l3
represents origin of light, angle between l1l2l3-c1c2c3 and normal is found to aid in shading
surface.  In mode ac=0 ,1 represents direct light, 0 =90 degrees difference, -1= 180 degrees
difference between light source and normal of surface,mode=1 gives angle, mode<>1 gives cosine of angle}
CROSSPRODUCT(A1,A2,A3,B1,B2,B3,C1,C2,C3,CP);
VUNIT(L1,L2,L3,c1,c2,c3,true,VUP);
a:=DOTPRODUCT(CP[1],CP[2],CP[3],VUP[1],VUP[2],VUP[3],0,0,0,true);
IF AC=1 THEN
BEGIN
LIGHT:=arccos(a);
END
ELSE
BEGIN
LIGHT:=a;
END;
END;

PROCEDURE VUNIT(I,J,K,o1,o2,o3:REAL;mode:boolean;VAR VU);
TYPE
UN=ARRAY[1..3] OF REAL;
VAR
A4,A5,A6,A7,A8,A9,A10,D1,D2,D3:REAL;
BEGIN
{vu is array[1..3] of real.  If mode is true, vu receives cosines of vector ijk-o1o2o3, if mode is false,
vu receives angles instead of cosines}
A4:=SQRT(((I-o1)*(I-o1))+((J-o2)*(J-o2))+((K-o3)*(K-o3)));
IF A4=0 THEN
BEGIN
A5:=I;
A6:=J;
A7:=K;
END
ELSE
BEGIN
A5:=I/A4;
A6:=J/A4;
A7:=K/A4;
END;
A8:=ARCCOS(A5);
A9:=ARCCOS(A6);
A10:=ARCCOS(A7);
if (mode=true) then
begin
UN(VU)[1]:=A5;
UN(VU)[2]:=A6;
UN(VU)[3]:=A7;
end
else
begin
UN(VU)[1]:=A8;
UN(VU)[2]:=A9;
UN(VU)[3]:=A10;
end;
END;

PROCEDURE CROSSPRODUCT(V1,V2,V3,V4,V5,V6,V7,V8,V9:REAL;VAR CA);
TYPE
CROSSP=ARRAY[1..3] OF REAL;
VAR
A1,A2,A3,A4,A5,A6,A7,B1,B2,B3,B4,B5,B6,B7,C1,C2,C3,C4,C5,C6,D1,D2,D3,D4,D5,D6:REAL;
BEGIN
{v7v8v9 is common point, v1v2v3-v7v8v9 rotates into v4v5v6-v7v8v9.  Result is cosines
of crossproduct stored in ca:array[1..3]of real}
C1:=-((V3-V9)*(V5-V8))+(V2-V8)*(V6-V9);
C2:=(V3-V9)*(V4-V7)-((V1-V7)*(V6-V9));
C3:=(V1-V7)*(V5-V8)-((V2-V8)*(V4-V7));
C4:=SQRT(SQR(C1)+SQR(C2)+SQR(C3));
IF C4=0 THEN
BEGIN
D1:=C1;
D2:=C2;
D3:=C3;
END
ELSE
BEGIN
D1:=C1/C4;
D2:=C2/C4;
D3:=C3/C4;
END;
CROSSP(CA)[1]:=D1;
CROSSP(CA)[2]:=D2;
CROSSP(CA)[3]:=D3;
END;

Function DOTPRODUCT(V1,V2,V3,V4,V5,V6,V7,V8,V9:REAL;mode:boolean):real;
VAR
A1,A2,A3,A4,A5,A6,A7,B1,B2,B3,B4,B5,B6,B7,C5,C6:REAL;
BEGIN
{v7v8v9 common point,  v1v2v3-v7v8v9 one vector, v4v5v6-v7v8v9 the other,
function gives cosine of angle between vectors for mode=true, for mode
equal false gives angle}
A4:=SQRT(((v1-v7)*(V1-V7))+((V2-V8)*(v2-v8))+((V3-V9)*(v3-v9)));
B4:=SQRT(((V4-V7)*(v4-v7))+((V5-V8)*(v5-v8))+((V6-V9)*(v6-v9)));
IF A4=0 THEN
BEGIN
A1:=V1-V7;
A2:=V2-V8;
A3:=V3-V9;
END
ELSE
BEGIN
A1:=(V1-V7)/A4;
A2:=(V2-V8)/A4;
A3:=(V3-V9)/A4;
END;
IF B4=0 THEN
BEGIN
B1:=V4-V7;
B2:=V5-V8;
B3:=V6-V9;
END
ELSE
BEGIN
B1:=(V4-V7)/B4;
B2:=(V5-V8)/B4;
B3:=(V6-V9)/B4;
END;
C5:=A1*B1+A2*B2+A3*B3;
C6:=ARCCOS(C5);
if (mode=true) then
begin
dotproduct:=c5;
end
else
begin
dotproduct:=c6;
end;
END;

PROCEDURE SORT5000(N:INTEGER;VAR OL, NL);
LABEL 3;
TYPE
OLH=ARRAY[1..5000] OF REAL;
NLH=ARRAY[1..5000] OF REAL;
VAR
P,I,J,H,S:INTEGER;
V:REAL;
BEGIN
{sorts real numbers in ol:array[1..x] of real from smallest to largest and places them in
nl:array[1..x] of real which you
provide. N is the number of numbers to be sorted.  ol and nl can be array of any size as
long as x is =<5000
Unless you change the type declaration for olh and nlh, arrays
cannot exceed 1..5000.  Method is supposed to be one of the fastest bubble sort methods}

FOR S:=1 TO N DO
BEGIN
NLH(NL)[S]:=OLH(OL)[S];
END;
H:=1;
WHILE H<=N DO
BEGIN
H:=3*H+1;
END;
REPEAT
H:=TRUNC(H/3);
FOR I:=H+1 TO N DO
BEGIN
V:=NLH(NL)[I];
J:=I;
WHILE NLH(NL)[J-H]>V DO
BEGIN
NLH(NL)[J]:=NLH(NL)[J-H];
J:=J-H;
IF J<=H THEN GOTO 3;
END;
3: NLH(NL)[J]:=V;
END;
UNTIL H=1;
END;

END.